:- module(compile,[pl_and_ir/4,compile_file/3,name_variables/2]).
:- use_module(parse).

lookup_k(K=V,[K1=V|_]) :- K == K1, !.
lookup_k(K=V,[_|KVs]) :- lookup_k(K=V,KVs).

lookup_v(K=V,[K=V1|_]) :- V == V1, !.
lookup_v(K=V,[_|KVs]) :- lookup_v(K=V,KVs).

lookup(K=V,Store) :- var(K), lookup_v(K=V,Store).
lookup(K=V,Store) :- nonvar(K), lookup_k(K=V,Store).

pl_and_ir(Variable,variable(Name),Store,Store)                 :- var(Variable), lookup(Name=Variable,Store), !.
pl_and_ir(Variable,variable(Name),Store,[Name=Variable|Store]) :- var(Variable).
pl_and_ir(Compound,compound(Name,Args),StoreI,StoreO) :- var(Compound), nonvar(Args),
 pl_and_ir_many(PLArgs,Args,StoreI,StoreO), Compound=..[Name|PLArgs].
pl_and_ir(Compound,compound(Name,Args),StoreI,StoreO) :- nonvar(Compound),
 Compound=..[Name|PLArgs], pl_and_ir_many(PLArgs,Args,StoreI,StoreO).

pl_and_ir_many([],[],Store,Store).
pl_and_ir_many([PL|PLs],[IR|IRs],StoreI,StoreO) :- pl_and_ir(PL,IR,StoreI,StoreM), pl_and_ir_many(PLs,IRs,StoreM,StoreO).

ir_functor(compound(':-',[compound(Name,Args),_]),Name/Arity) :- !, length(Args, Arity).
ir_functor(compound(Name,Args),Name/Arity) :- length(Args, Arity).

directive(Clause) :- ir_functor(Clause,(:-)/1).

select_relation(_, [], [], []).
select_relation(F, [C|Cs], [C|Fs], Ys) :-
 ir_functor(C, F), !, select_relation(F, Cs, Fs, Ys).
select_relation(F, [C|Cs], Fs, [C|Ys]) :-
 select_relation(F, Cs, Fs, Ys).

group_clauses([], [], []).
group_clauses([D|Ds], [D|Cs], Rs) :-
 directive(D), !,
 group_clauses(Ds, Cs, Rs).
group_clauses(Ds, [C|Cs], [R|Rs]) :-
 ir_functor(C, Name/Arity),
 select_relation(Name/Arity, [C|Cs], R, CsRemain), 
 group_clauses(Ds, CsRemain, Rs).

simplify_relation(Relation, Simple) :- maplist(simplify_clause, Relation, Simple).
simplify_clause(Clause, Head-Body) :-
 ( Clause = compound(':-',[Head,Term]) -> flatten(Term, Body, [])
 ; Clause = Head, Body = [] ).

flatten(compound(',',[X,Y])) --> flatten(X), flatten(Y).
flatten(P) --> {P \= compound(',',[_,_])}, [P].

javafy(Mod, Relations, Text) :- javafy(Mod, Relations, Text, []).
javafy(Mod, Relations) --> javafy_prologue(Mod), javafy_body(Relations), javafy_epilogue.
javafy_prologue(Mod) -->
 "public class ",Mod," extends Module {\n",
 "public Stack<Choicepoint> tryToContinue(Compound term, int choice, Stack<Choicepoint> choicepoints, Unifier unifier) {\n",
 "int nextHeight = choicepoints.height+1;\n",
 "Stack<Conjunct> query = choicepoints.head.query.tail;\n".
javafy_body([])           --> [].
javafy_body([Clauses|Xs]) -->
 {Clauses=[compound(Name,Args)-_|_],atom_codes(Name,NameS),length(Args,Arity),atom_codes(Arity,ArityS)},
 "if(term.arity == ",ArityS," && term.name.equals(",string(NameS),")) {\n",
 javafy_clauses(1,Clauses),
 "}\n",
 javafy_body(Xs).
javafy_clauses(I,[Head-Body|Clauses]) -->
 {atom_codes(I,Ic),succ(I,J)},
 ({I = 1} -> {true} ; "else "),"if(choice == ",Ic,") {\n",
 javafy_term(Head/HName,[]/Store,1/K),
 "if(unifier.unify(term,",HName,")) {\n",
 "status = Module.Status.Success;\n",
 javafy_build_query(Body,Store/_,K/_),
 "return new Stack<Choicepoint>(new Choicepoint(query,unifier.bound,false),choicepoints);\n",
   /*
 ( {Body = []} ->
   "status = Module.Status.Success;\n",
   "return Choicepoint.push(choicepoints,unifier.bound);\n"
   ; {Body=[BTerm]}, %% TODO: support lists of other length
     javafy_term(BTerm/BName,Store/_,K/_),
     "status = Module.Status.Success;\n",
     "return Choicepoint.push(choicepoints,unifier.bound,\n",
     BName,");\n" ),
     */
 "}\n",
 "else {\n",
 "status = Module.Status.TryAgain;\n", %% TODO: leave this else {} off if the Clauses are [] so that it falls through to status=ThatsAll (as well overwriting the choicepoint rather than returning an new one)
 "return choicepoints;\n",
 "}\n",
 "}\n",
 javafy_clauses(J,Clauses).
javafy_clauses(_,[])                  -->
 "status = Module.Status.ThatsAll;\n",
 "return choicepoints;\n".
javafy_epilogue -->
 "status = Module.Status.NotFound;\n",
 "return choicepoints;\n",
 "}\n",
 "}\n".

%% TODO: It may be possible to not have to even create the inner class at all in some cases (implement this)
javafy_build_query([],Store/Store,I/I)       --> [].
javafy_build_query([compound('java',[Return,compound(Name,[])|Args])|Ts],StoreI/StoreO,I/O) --> !,
 {atom_codes(Name,NameC)},
 javafy_build_query(Ts,StoreI/StoreO,I/O),
 "query = new Stack<Conjunct>(new JavaCall() { public boolean call() {\n",
 "try {\n",
 NameC,"(",jcall_emit_args(Args,StoreO),");\n",
 "return true;\n",
 "} catch(Exception e) { return false; }\n",
 "}},query);\n".
javafy_build_query([T|Ts],StoreI/StoreO,I/O) -->
 javafy_build_query(Ts,StoreI/StoreM,I/M),
 javafy_term(T/Name,StoreM/StoreO,M/O),
 "query = new Stack<Conjunct>(new Predicate(",Name,",0,nextHeight),query);\n".

jcall_emit_args([],_) --> [].
jcall_emit_args([compound('/',[compound(Ty,[]),variable(Vr)])|Gs],Store) --> %% TODO: support all terms
 {member(Code=Vr,Store)},
 Code,".coerceTo",coercion(Ty),"()",
 ({Gs = []} -> ""; ", "),jcall_emit_args(Gs,Store).
coercion(char) --> "Char".
coercion(string) --> "String".


javafy_term(variable(Name)/Code,Store/Store,I/I) --> {member(Code=Name,Store), !}.
javafy_term(variable(Name)/Code,Store/[Code=Name|Store],I/J) --> {succ(I,J), concat_atom([t,I],VName), atom_codes(VName,Code)},
 "final Term ",Code," = new Variable();\n".
javafy_term(compound(Name,Args)/Code,StoreI/StoreO,I/K) --> {succ(I,J), concat_atom([t,I],VName), atom_codes(VName,Code), atom_codes(Name,NameC)},
 javafy_rest_terms(Args/Names,StoreI/StoreO,J/K),
 "final Term ",Code," = new Compound(",string(NameC),splat(Names),");\n".

javafy_rest_terms([]/[],Store/Store,I/I) --> [].
javafy_rest_terms([T|Ts]/[N|Ns],StoreI/StoreO,I/O) -->
 javafy_term(T/N,StoreI/StoreM,I/M),
 javafy_rest_terms(Ts/Ns,StoreM/StoreO,M/O).

splat([])     --> [].
splat([X|Xs]) --> ", ",X,splat(Xs).

string(String) --> [0'"],string_body(String),!,[0'"].
string_body([0'"|Cs]) --> [0'\\],[0'"], string_body(Cs).
string_body([0'\\|Cs]) --> [0'\\],[0'\\], string_body(Cs).
string_body([C|Cs]) --> [C], string_body(Cs).
string_body([]) --> [].

name_variables(_,[]).
name_variables(I,[Name=_|Rest]) :- var(Name), concat_atom(['V',I],Name), succ(I,J), name_variables(J,Rest).
name_variables(I,[Name=_|Rest]) :- nonvar(Name), name_variables(I,Rest).

expand_ir_term(IR1, IR2) :-
 pl_and_ir(PL1,IR1,[],_),
 '$foo$term_expansion'(PL1,PL2),!,
 pl_and_ir(PL2,IR2,[],Store),
 name_variables(1,Store).
expand_ir_term(IR, IR).

compile_file(ModuleName) -->   {write('%%% '),nl},
 parse_file,                   {write('parsed..'),nl},
 maplist(expand_ir_term),      {write('expanded..'),nl},
 group_clauses(Directives),    {write('grouped..'),nl},
 maplist(simplify_relation),   {write('simplified..'),nl},
 javafy(ModuleName),           {write('javafy''d..'),nl}.
